home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / RESHANDL.I < prev    next >
Encoding:
Text File  |  1990-11-10  |  10.9 KB  |  3 lines
  1. ⓪ IMPLEMENTATION MODULE ResHandler;⓪ (*$R-,Y+*)⓪ (*  $S- findet sich weiter unten! *)⓪ ⓪ (*------------------------------------------------------------------------------⓪!* Version 1.3⓪!*------------------------------------------------------------------------------⓪!* Copyright © 1989, 1990 by Michael Seyfried⓪!*------------------------------------------------------------------------------⓪!*       89 MS 1.0  Ersterstellung aus SysLibDemo⓪!* 29.09.89 MS 1.1  Vorschläge von Thomas Tempelmann berücksichtigt⓪!* 30.09.89 MS 1.1a Kleine Korrekturen; Modul erfolgreich ausgetestet.⓪!* 02.01.90 MS 1.1a Modul mit korrigiertem Loader erfolgreich ausgetestet.⓪!* 12.05.90 MS 1.3  Namensänderungen von TT übernommen. Die Freigabeprozedur hat⓪!*                  nun einen zusätzlichen Parameter, mit dessen Hilfe man fest-⓪!*                  stellen kann, ob sie vom Benutzer oder vom System aufgerufen⓪!*                  wird.⓪!* 27.05.90 TT      Doku in Def-Modul korrigiert (Kommata, usw), sowie im Modul-⓪!*                  Kopf 2 neue Absätze (am Ende). Statt ErrBase.RaiseError wird⓪!*                  SystemError.OutOfMemory aufgerufen⓪!* 30.05.90 TT      $Y+ eingefügt⓪!* 10.11.90 TT      $S- weiter unten eingefügt⓪!*------------------------------------------------------------------------------⓪!*)⓪ ⓪ FROM SYSTEM IMPORT ADDRESS, ADR;⓪ ⓪ FROM MOSGlobals IMPORT MemArea;⓪ ⓪ FROM SystemError IMPORT OutOfMemory;⓪ ⓪ FROM PrgCtrl IMPORT CatchProcessTerm, TermCarrier, SetEnvelope, EnvlpCarrier;⓪ ⓪ FROM ResCtrl IMPORT CatchRemoval, RemovalCarrier;⓪ ⓪ FROM Storage IMPORT SysAlloc, DEALLOCATE; (* Systemmodul, daher 'SysAlloc' *)⓪ ⓪ FROM Strings IMPORT Relation;⓪ ⓪ FROM Lists IMPORT List, SysCreateList, DeleteList, ResetList, AppendEntry,⓪2PrevEntry, NextEntry, CurrentEntry, RemoveEntry, FindEntry,⓪2ListEmpty, LCarrier, InsertEntry;⓪ ⓪ (*⓪ IMPORT Terminal;⓪ ⓪ IMPORT Strings;⓪ ⓪ IMPORT StrConv;⓪ ⓪ FROM SYSTEM IMPORT LONGWORD, VAL;⓪ *)⓪ ⓪ ⓪ CONST SysLevel        = -1;         (* Systemlevel *)⓪ ⓪ TYPE  Resource = POINTER TO List;⓪ ⓪&ListEntry = RECORD⓪4level: INTEGER;       (* Systemlevel der Resource *)⓪4resHdl: ADDRESS;      (* Kennung der Resource *)⓪4delProc: CloseProc;   (* Freigabe-Prozedur *)⓪2END;⓪ ⓪&PtrListEntry = POINTER TO ListEntry;⓪ ⓪ VAR   MyLevel: INTEGER;                   (* aktuelles Systemlevel *)⓪&ResListList: List;                  (* Liste aller Resource-Listen *)⓪ ⓪ ⓪ (*⓪ (* Die folgenden Prozeduren sind für's Debugging gedacht. Ich habe sie⓪!* vorsichtshalber nicht gelöscht (man kann nie wissen). Das Modul ist⓪!* mit Hilfe dieser Routinen und 'SysLibDemo' ausgetestet worden. Es⓪!* sollte also weitgehend ohne Fehler sein.⓪!*)⓪ PROCEDURE Info( msg: ARRAY OF CHAR);⓪"BEGIN⓪$Terminal.WriteString( msg);⓪$Terminal.WriteLn⓪"END Info;⓪ ⓪ PROCEDURE Wait;⓪"VAR wait: CHAR;⓪"BEGIN⓪$Terminal.WriteString( 'waiting ');⓪$Terminal.Read( wait)⓪"END Wait;⓪ ⓪ PROCEDURE ShowLHex( LongWord: LONGWORD);⓪"VAR Str: Strings.String;⓪"BEGIN⓪$Str:= StrConv.LHexToStr( VAL( LONGCARD, LongWord), 10);⓪$Terminal.WriteString( Str);⓪$Terminal.WriteLn;⓪"END ShowLHex;⓪ ⓪ PROCEDURE ShowResource( ResList: Resource);⓪"VAR OldCurrent: LCarrier;⓪&EntryPtr: PtrListEntry;⓪"BEGIN⓪$OldCurrent:= ResList^.current;⓪$Info( 'ShowResource');⓪$ShowLHex( ResList);⓪$ResetList( ResList^);⓪$WHILE NextEntry( ResList^) # NIL DO⓪&EntryPtr:= CurrentEntry( ResList^);⓪&ShowLHex( EntryPtr^.resHdl)⓪$END;⓪$Wait;⓪$ResList^.current:= OldCurrent;⓪"END ShowResource;⓪ ⓪ PROCEDURE ShowList( list: List);⓪"VAR OldCurrent: LCarrier;⓪"BEGIN⓪$OldCurrent:= list.current;⓪$Info( 'ShowList');⓪$ResetList( list);⓪$WHILE NextEntry( list) # NIL DO⓪&ShowLHex( CurrentEntry( list))⓪$END;⓪$Wait;⓪$list.current:= OldCurrent;⓪"END ShowList;⓪ *)⓪ ⓪ ⓪ PROCEDURE CreateResource( VAR ResList: Resource; VAR error: BOOLEAN);⓪ ⓪"VAR voidB: BOOLEAN;⓪ ⓪"BEGIN⓪$SysAlloc( ResList, SIZE( ResList^));⓪$IF ResList # NIL THEN⓪&SysCreateList( ResList^, error);⓪&IF error THEN⓪((* Fehler => Speicher freigeben *)⓪(DEALLOCATE( ResList, 0)⓪&ELSE⓪((* Resource-Liste am Anfang der Liste der Resource-Listen einfügen *)⓪(ResetList( ResListList);⓪(InsertEntry( ResListList, ResList, error);⓪(IF error THEN⓪*(* im Fehlerfall Speicher wieder freigeben *)⓪*DeleteList( ResList^, voidB);⓪*DEALLOCATE( ResList, 0)⓪(END⓪&END⓪$ELSE⓪&error:= TRUE;⓪$END;⓪"END CreateResource;⓪ ⓪ PROCEDURE insertResource(     useLevel: INTEGER;⓪>ResList: Resource;⓪>ResHdl: ADDRESS;⓪>ResDel: CloseProc;⓪:VAR error: BOOLEAN);⓪ ⓪"VAR EntryPtr: PtrListEntry;⓪&OldCurrent: LCarrier;⓪ ⓪"BEGIN⓪$SysAlloc( EntryPtr, SIZE( EntryPtr^));⓪$IF EntryPtr # NIL THEN⓪&WITH EntryPtr^ DO⓪(level:= useLevel;⓪(resHdl:= ResHdl;⓪(delProc:= ResDel⓪&END;⓪ ⓪&(* 'current' merken *)⓪&OldCurrent:= ResList^.current;⓪ ⓪&(* Neues Element am Anfang der Liste einfügen *)⓪&ResetList( ResList^);⓪&InsertEntry( ResList^, EntryPtr, error);⓪ ⓪&(* 'current' zurückschreiben *)⓪&ResList^.current:= OldCurrent;⓪$ELSE⓪&error:= TRUE⓪$END;⓪"END insertResource;⓪ ⓪ PROCEDURE InsertHandle(     ResList: Resource;⓪>ResHdl: ADDRESS;⓪>ResDel: CloseProc;⓪:VAR error: BOOLEAN);⓪"BEGIN⓪$insertResource( MyLevel, ResList, ResHdl, ResDel, error)⓪"END InsertHandle;⓪ ⓪ PROCEDURE InsertSysHandle(     ResList: Resource;⓪AResHdl: ADDRESS;⓪AResDel: CloseProc;⓪=VAR error: BOOLEAN);⓪"BEGIN⓪$insertResource( SysLevel, ResList, ResHdl, ResDel, error)⓪"END InsertSysHandle;⓪ ⓪ PROCEDURE HandleInList( ResList: Resource; ResHdl: ADDRESS): BOOLEAN;⓪ ⓪"VAR EntryPtr: PtrListEntry;⓪&OldCurrent: LCarrier;⓪ ⓪"BEGIN⓪$OldCurrent:= ResList^.current;⓪$ResetList ( ResList^ );⓪$WHILE NextEntry ( ResList^ ) # NIL DO⓪&EntryPtr:= CurrentEntry ( ResList^ );⓪&IF EntryPtr^.resHdl = ResHdl THEN⓪(ResList^.current:= OldCurrent;⓪(RETURN TRUE⓪&END⓪$END;⓪$ResList^.current:= OldCurrent;⓪$RETURN FALSE⓪"END HandleInList;⓪ ⓪ PROCEDURE FirstHandle( ResList: Resource): ADDRESS;⓪ ⓪"VAR EntryPtr: PtrListEntry;⓪ ⓪"BEGIN⓪$ResetList( ResList^);⓪$EntryPtr:= NextEntry( ResList^);⓪$IF EntryPtr = NIL THEN⓪&RETURN NIL⓪$ELSE⓪&RETURN EntryPtr^.resHdl⓪$END⓪"END FirstHandle;⓪ ⓪ PROCEDURE NextHandle( ResList: Resource): ADDRESS;⓪ ⓪"VAR EntryPtr: PtrListEntry;⓪ ⓪"BEGIN⓪$EntryPtr:= NextEntry( ResList^);⓪$IF EntryPtr = NIL THEN⓪&RETURN NIL⓪$ELSE⓪&RETURN EntryPtr^.resHdl⓪$END⓪"END NextHandle;⓪ ⓪ ⓪ (*$S-  ab hier kein Stackcheck mehr *)⓪ ⓪ ⓪ PROCEDURE ResourceDelete( EntryPtr: PtrListEntry; user: BOOLEAN);⓪ ⓪"BEGIN⓪$WITH EntryPtr^ DO⓪&delProc( resHdl, user)⓪$END;⓪$DEALLOCATE( EntryPtr, 0);⓪"END ResourceDelete;⓪ ⓪ PROCEDURE RemoveHandle( ResList: Resource; ResHdl: ADDRESS);⓪ (*⓪!* ResList^.current wird nur verändert, wenn dieser Zeiger auf das zu löschende⓪!* Listenelement zeigt. Dann zeigt er anschließend auf den Vorgänger. Dies ist⓪!* wichtig, damit 'RemoveHandle' auch zwischen 'FirstHandle' und⓪!* 'NextHandle' verwendet werden kann.⓪!*)⓪"VAR error, setOldCurrent: BOOLEAN;⓪&EntryPtr: PtrListEntry;⓪&OldCurrent: LCarrier;⓪ ⓪"BEGIN⓪$OldCurrent:= ResList^.current;⓪$ResetList ( ResList^ );⓪$WHILE NextEntry ( ResList^ ) # NIL DO⓪&EntryPtr:= CurrentEntry ( ResList^ );⓪&IF EntryPtr^.resHdl = ResHdl THEN⓪(setOldCurrent:= OldCurrent # ResList^.current;⓪(RemoveEntry( ResList^, error);        (* Aus Liste löschen *)⓪(IF setOldCurrent THEN⓪*ResList^.current:= OldCurrent⓪(END;⓪(ResourceDelete( EntryPtr, TRUE);      (* Freigabe-Prozedur aufrufen *)⓪(RETURN                                (* nur ein Handle löschen *)⓪&END⓪$END;⓪$ResList^.current:= OldCurrent⓪"END RemoveHandle;⓪ ⓪ PROCEDURE ResListCloseLevel( ResList: Resource);⓪ ⓪"VAR EntryPtr: PtrListEntry;⓪&error: BOOLEAN;⓪ ⓪"BEGIN⓪$ResetList ( ResList^ );⓪$WHILE NextEntry ( ResList^) # NIL DO⓪&EntryPtr:= CurrentEntry ( ResList^ );⓪&IF EntryPtr^.level >= MyLevel THEN⓪(RemoveEntry( ResList^, error);        (* Aus Liste löschen *)⓪(ResourceDelete( EntryPtr, FALSE);     (* Freigabe-Prozedur aufrufen *)⓪&END⓪$END;⓪"END ResListCloseLevel;⓪ ⓪ PROCEDURE CloseLevel;⓪"(*⓪#* Schließt alle Zugriffe, die unter dem gerade beendeten Prozeß⓪#* geöffnet wurden.⓪#*)⓪"BEGIN⓪$ResetList ( ResListList);⓪$WHILE NextEntry ( ResListList) # NIL DO⓪&(* für alle Resource-Listen ... *)⓪&ResListCloseLevel( CurrentEntry( ResListList)); (* Einträge schließen *)⓪$END;⓪"END CloseLevel;⓪ ⓪ PROCEDURE Envelope ( starting, inChild: BOOLEAN; VAR exitCode: INTEGER );⓪"BEGIN⓪$IF inChild THEN⓪&IF starting THEN⓪(INC ( MyLevel );⓪&ELSE⓪(CloseLevel;⓪(DEC ( MyLevel )⓪&END⓪$END⓪"END Envelope;⓪ ⓪ PROCEDURE Removal;⓪ ⓪"PROCEDURE DeleteResList( ResList: Resource);⓪"(*⓪#* Es werden alle Einträge aus der Liste entfernt. Anschließend wird die Liste⓪#* gelöscht.⓪#*)⓪$VAR EntryPtr: PtrListEntry;⓪(error: BOOLEAN;⓪ ⓪$BEGIN⓪&(* Zunächst Liste leeren *)⓪&ResetList( ResList^);⓪&WHILE NextEntry( ResList^) # NIL DO⓪((* Die Listenelemente selbst werden nicht gelöscht, da Sys-Resourcen !⓪)* (Andere Resourcen wurden schon bei 'CloseLevel' geschlossen.)⓪)*)⓪(EntryPtr:= CurrentEntry( ResList^);⓪(DEALLOCATE( EntryPtr, 0);⓪(RemoveEntry( ResList^, error);⓪&END;⓪ ⓪&(* Liste selbst löschen *)⓪&DeleteList( ResList^, error);⓪ ⓪&DEALLOCATE( ResList, 0);⓪$END DeleteResList;⓪ ⓪"VAR error: BOOLEAN;⓪ ⓪"BEGIN⓪$(* Die Resource-Listen werden gelöscht, da das Modul gerade terminiert.⓪%* Alle Resourcen, die mit 'InsertSysHandle' in eine Liste eingefügt⓪%* wurden, bleiben aber geöffnet !!⓪%*)⓪ ⓪$(* Zunächst alle Resource-Listen löschen *)⓪$ResetList( ResListList);⓪$WHILE NextEntry( ResListList) # NIL DO⓪&DeleteResList( CurrentEntry( ResListList));⓪&RemoveEntry( ResListList, error);⓪$END;⓪ ⓪$(* Nun leere Liste der Resource-Listen löschen *)⓪$DeleteList( ResListList, error);⓪"END Removal;⓪ ⓪ VAR tCarrier: TermCarrier;⓪$eCarrier: EnvlpCarrier;⓪$rCarrier: RemovalCarrier;⓪ ⓪ PROCEDURE InitModule(): BOOLEAN;⓪ ⓪"VAR error: BOOLEAN;⓪&wsp: MemArea;⓪ ⓪"BEGIN⓪$MyLevel:= 0;⓪$(* Liste der Resource - Listen anlegen *)⓪$SysCreateList( ResListList, error);⓪$IF error THEN⓪&RETURN FALSE⓪$ELSE⓪&wsp.bottom:= NIL;⓪&CatchProcessTerm ( tCarrier, CloseLevel, wsp );⓪&SetEnvelope ( eCarrier, Envelope, wsp );⓪&CatchRemoval ( rCarrier, Removal, wsp );⓪&RETURN TRUE⓪$END;⓪"END InitModule;⓪ ⓪ BEGIN⓪"IF NOT InitModule() THEN⓪$OutOfMemory⓪"END⓪ END ResHandler.⓪ ə
  2. (* $FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6E$FFEF8D6EÇ$000004D3T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00001598$00002542$000013FE$0000005A$000004AF$000004C5$000004D3$FFEE2C3C$000020BE$00001FD2$00001949$0000197F$00001859$00001B59$00001759$00001763£Çé*)
  3.